Scene 96/Scene 96 International Edition (Zyklop Software) (Disc 2) (1997).iso/misc/coding/onenssrc/part1.pas

Pascal/Delphi Source File | 1996-01-18 | 5KB | 279 lines

unit Part1;

interface

uses
    zipvga, {liktwk,} crt, oneres, fastsine;

    procedure Run;

implementation

const
    firstframe = 0;
    lastframe = firstframe + 1024;

var
    i, j, k, d : word;
    swerve : integer;
    aswerve : word;
    f : longint;
    scr, tab, pic : ^screen2;
    scrs, tabs, pics : word;

    procedure MakePic;

    var
        i, j : word;

    begin
        for i := 0 to 65535 do
            vscr2[i] := random(128) + random(128) + 1;
        pic^ := vscr2;
        {for i := 0 to 65535 do
            vscr2[i] := (pic^[i+1] + pic^[i-1] + pic^[i+256] + pic^[i-256]) div 8
                    + (pic^[i+321] + pic^[i - 321] + pic^[i+319] - pic^[i-319]) div 8;}
        for j := 0 to 2 do
         begin
            for i := 0 to 65535 do
                vscr2[i] := (pic^[i+1] + pic^[i] + pic^[i+320] + pic^[i+321]) div 4 + random(4) - random(4);
            pic^ := vscr2;
         end;
    end;

    (*procedure MakeTabs;

    var
        dx, dy : integer;
        z, d : longint;

    begin
        brightness (63, 0);
        {if not loadpic2('tunnel.tab', tab^) then}
         begin
            for dx := -160 to 159 do
             begin
                for dy := -50 to 49 do
                 begin
                    if dx = 0 then
                     begin
                        if dy > 0 then
                            tab^[(dy + 50)*320 + dx + 160] := 64
                        else
                            tab^[(dy + 50)*320 + dx + 160] := 192;
                     end
                    else
                        tab^[(dy + 50)*320 + dx + 160] := round(arctan(dy/dx)*256/2/pi);
                    if dx < 0 then
                        tab^[(dy + 50)*320 + dx + 160] := (tab^[(dy + 50)*320 + dx + 160] + 128) mod 256;
                 end;
                vscr2 := tab^;
             end;

            for dx := -160 to 159 do
             begin
                for dy := -50 to 49 do
                 begin
                    z := dx*dx + dy*dy;
                    d := round(256000/(sqrt(z) + 1)) div 100;
                    tab^[(dy + 50)*320 + 32768 + dx + 160] := mini(d, 255);
                 end;
                vscr2 := tab^;
             end;

            savepic2 ('tunnel.tab', tab^);
         end;

        vscr2 := tab^;
    end;*)

procedure Run;

begin
    {new (scr);}
    scr := @vscr2;
    new (tab);
    new (pic);
    scrs := seg(scr^);
    tabs := seg(tab^);
    pics := seg(pic^);

    initb;
    {init60hz256256256c;}

    initvga;

    brightness (0, 0);

    MakePic;
    {readkey;}

    {MakeTabs;
    readkey;}
    fetch ('tunnel.tab');
    blockread (lf, tab^, 32768);
    blockread (lf, tab^[32768], 32768);

    filldword (vscr, 16384, 0);

    j := 0;
    k := 0;
    f := 0;
    repeat
        getpos;
        f := track*256 + row*4;
        if f < firstframe + 256 then
            brightness ((f - firstframe) div 4, 0)
        else if f > lastframe - 64 then
            brightness ((lastframe - f), (f - lastframe + 64));
        {for i := 0 to 32767 do
         begin
            d := tab^[i+32768];
            vscr2[i+63*256] := pic^[d*256 + tab^[i] + j*3*256 + j]*(255 - d) div 256;
         end;}

        {retrace;}
        {setrgb (0, 31, 0, 0);}

        {swerve := ssin(f) div 16 + (scos(f) div 16)*320;}
        if f < firstframe + 160 then
            swerve := 160 - f + firstframe
        else if f > lastframe - 160 then
            swerve := - 160 + lastframe - f
        else
            swerve := 0;
        aswerve := abs(swerve);

        {repeat until sync;
        sync := false;}
        if trapretrace then
            retrace;
        asm
            mov ax, k
            mov ah, al
            xor al, al
            mov si, ax
            add si, j

            mov cx, [aswerve]

            xor di, di
            cmp [swerve], 0
            jg @AtEnd
            xor al, al
            mov dx, [scrs]
            mov es, dx
            add di, 50*320
            rep stosb
            sub di, 50*320
         @AtEnd:

            mov cx, 32000
            sub cx, [aswerve]
         @Loop:
            mov dx, [tabs]
            mov es, dx

            mov bh, es:[di]
            add di, [swerve]
            mov bl, es:[di+32768]
            sub di, [swerve]

            mov dx, [pics]
            mov es, dx

            mov al, es:[bx+si]
            mov ah, 255
            sub ah, bl
            mul ah

            mov dx, 0A000h {[scrs]}
            mov es, dx

            mov es:[di+50*320], ah

            inc di
            dec cx
            jnz @Loop

            cmp [swerve], 0
            jl @AtBeginning
            add di, 50*320
            mov cx, [aswerve]
            xor al, al
            rep stosb
         @AtBeginning:
        end;
        (*asm
            mov dx, [tabs]
            mov es, dx

            mov dx, [pics]
            {mov fs, dx} db $8E,$E2

            mov dx, [scrs]
            {mov gs, dx} db $8E,$EA

            mov ax, k
            mov ah, al
            xor al, al
            mov si, ax
            add si, j

            mov cx, [aswerve]

            xor di, di
            cmp [swerve], 0
            jg @AtEnd
            xor al, al
            mov dx, [scrs]
            mov es, dx
            add di, 50*320
            rep stosb
            sub di, 50*320
         @AtEnd:

            mov cx, 32000
            sub cx, [aswerve]
         @Loop:
            mov dx, [tabs]
            mov es, dx

            mov bh, es:[di]
            add di, [swerve]
            mov bl, es:[di+32768]
            sub di, [swerve]

            {mov al, fs:[bx+si]} db $64,$8A,$00
            mov ah, 255
            sub ah, bl
            mul ah

            {mov gs:[di+50*320], ah} db $65,$88,$A5,$80,$3E

            inc di
            dec cx
            jnz @Loop

            cmp [swerve], 0
            jl @AtBeginning
            add di, 50*320
            mov cx, [aswerve]
            xor al, al
            rep stosb
         @AtBeginning:
        end;*)
        {setrgb (0, 0, 0, 0);}

        {for i := 0 to 15 do
            inc (pic^[j + k*256], random(64));}

        inc (j, 2);
        inc (k, 1);
    until keypressed or (f >= lastframe);

    dispose (tab);
    dispose (pic);
end;

end.